home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 22
/
Cream of the Crop 22.iso
/
os2
/
tktools.zip
/
turkish
/
teacher.bas
< prev
next >
Wrap
BASIC Source File
|
1996-08-18
|
10KB
|
408 lines
' Code by Turgut Kalfaoglu
' Elementary Turkish Teacher with incomplete lessons.
' If you like this program, PLEASE send $20 to:
' Turgut Kalfaoglu
' 1378 Sok, 8/10
' Alsancak, Izmir
' Version 2... released 18 august 1996
REM $INCLUDE: 'bsedospc.bi'
DEFINT A-Z
DECLARE SUB GRABKEY (V$)
declare sub os2sound(freq,dur)
100 OPTION BASE 1
DIM TURK$(500), ENG$(500), FOUND%(500), SCR(2000)
110 CLS
RANDOMIZE TIMER
COLOR 3
PRINT " Turkish Tutor Version 2.0"
PRINT " A program by Turgut Kalfaoglu"
PRINT " 1378 Sok. 8/10, Izmir, Turkey"
PRINT
PRINT "Special Key assignments: See bottom of screen."
KEY ON
KEY 1, CHR$(153)
KEY 2, CHR$(154)
KEY 3, CHR$(143)
KEY 4, CHR$(128)
KEY 5, CHR$(36)
PRINT
COLOR 9
PRINT "Choose lesson number(s) -separated by commas&dashes- to begin:"
PRINT
COLOR 4
CLOSE 1
OPEN "TEACHER.DAT" FOR RANDOM AS 1 LEN = 34
FIELD #1, 2 AS LES.NO$, 16 AS WORD$, 16 AS CORR$
PR$ = ""
MINLESS = 9999
MAXLESS = 0
WHILE NOT EOF(1)
GET #1
VLN = VAL(LES.NO$)
IF VLN <> 0 THEN
IF INSTR(PR$, "\" + (LES.NO$) + "\") = 0 THEN PRINT LES.NO$, : PR$ = PR$ + "\" + LES.NO$ + "\"
IF VLN > MAXLESS THEN MAXLESS = VLN
IF VLN < MINLESS THEN MINLESS = VLN
END IF
WEND
COLOR 3
ASK.AGAIN:
LOCATE 20, 1, 1
PRINT "Other commands:"
PRINT
COLOR 31: PRINT "A"; : COLOR 11: PRINT "dd words ";
COLOR 31: PRINT "E"; : COLOR 11: PRINT "dit words ";
COLOR 31: PRINT "R"; : COLOR 11: PRINT "andom ";
COLOR 31: PRINT "S"; : COLOR 11: PRINT "earch ";
COLOR 31: PRINT "H"; : COLOR 11: PRINT "elp ";
COLOR 31: PRINT "Q"; : COLOR 11: PRINT "uit ";
t$ = ""
AG:
CALL GRABKEY(Q$)
PRINT Q$;
IF (Q$ >= "0" AND Q$ <= "9") OR (Q$ = ",") OR Q$ = "-" THEN t$ = t$ + Q$: GOTO AG
GotInput:
A$ = t$
IF Q$ = "A" THEN GOSUB ADD: CLOSE : GOTO 100
IF Q$ = "E" THEN GOSUB EDIT: CLOSE : GOTO 100
IF Q$ = "R" THEN GOSUB RANDIT : Q$=CHR$(13): GOTO GotInput
IF Q$ = "S" THEN GOSUB SEARCH: CLOSE : GOTO 100
IF Q$ = "Q" THEN CLOSE : PRINT : LOCATE 24, 1: PRINT "Hope you had fun!": END
IF VAL(A$) = 0 THEN t$ = "": GOSUB EXPLAIN: GOTO 110
WHILE (INSTR(A$, "-")) 'resolving dashes
I = INSTR(A$, "-")
IF t > 0 THEN
L$ = LEFT$(A$, I - 1)
r$ = MID$(A$, I + 1)
FROM$ = ""
FOR t = LEN(L$) TO 1 STEP -1
t$ = MID$(L$, t, 1)
IF t$ < "0" OR t$ > "9" THEN EXIT FOR
FROM$ = t$ + FROM$
NEXT
FROM = VAL(FROM$)
L$ = LEFT$(L$, t)
FOR t = 1 TO LEN(r$)
t$ = MID$(r$, t, 1)
IF t$ < "0" OR t$ > "9" THEN EXIT FOR
NEXT
till = VAL(LEFT$(r$, t - 1))
r$ = MID$(r$, t)
IF till < FROM THEN SWAP till, FROM
n$ = ""
FOR t = FROM TO till
n$ = n$ + "," + MID$(STR$(t), 2)
NEXT
n$ = MID$(n$, 2)
A$ = L$ + n$ + r$
END IF 'does - exist here?
WEND
A$ = "," + A$ + ","
GET #1, 1
I = 1
COLOR 7
WHILE NOT EOF(1) AND I < 501
GET #1 'read a record
t$ = "," + RTRIM$(LES.NO$) + ","
IF INSTR(A$, t$) > 0 THEN
LOCATE 24, 1
PRINT "Loading lesson #"; LES.NO$; " ";
TURK$(I) = WORD$
ENG$(I) = CORR$ + LES.NO$
FOUND%(I) = 0
I = I + 1
END IF
WEND
COLOR 9
TOTAL.WORDS = I - 1
IF TOTAL.WORDS = 0 THEN 100
WORDS:
COLOR 9
QUEST = QUEST + 1
CLS
RN = INT(RND * 2) + 1
PRINT "What does this word mean in ";
IF RN = 2 THEN PRINT "Turkish?"; ELSE PRINT "English?";
DONE = 0
COUNTER = 0
WHILE COUNTER < 100 AND NOT DONE
Q = INT(RND * TOTAL.WORDS) + 1
IF FOUND%(Q) = 0 THEN DONE = -1
COUNTER = COUNTER + 1
WEND
FROM.LESSON = VAL(MID$(ENG$(Q), 17))
TMP$ = ENG$(Q)
ENG$(Q) = LEFT$(ENG$(Q), 16)
IF FROM.LESSON > 0 THEN PRINT " ( from lesson"; FROM.LESSON; " )" ELSE PRINT
IF RN = 1 THEN
ASKFOR$ = TURK$(Q)
ANSWER$ = ENG$(Q)
ELSE
ASKFOR$ = ENG$(Q)
ANSWER$ = TURK$(Q)
END IF
LOCATE 10, 25
COLOR 5
PRINT ASKFOR$
t = INSTR(ANSWER$, " ")
IF t > 0 THEN ANS$ = LEFT$(ANSWER$, t - 1) ELSE ANS$ = ANSWER$
FAUL = 0
AGAIN: LOCATE 12, 25
PRINT SPACE$(40);
LOCATE , 25
COLOR 7
INPUT "", GUESS$
GUESS$ = UCASE$(GUESS$)
COLOR 9
G = LEN(GUESS$)
IF G = 0 THEN FAUL = 5
IF ANS$ <> GUESS$ THEN
IF INSTR(ANS$, GUESS$ + "/") > 0 AND LEN(GUESS$) > 1 THEN GOTO NEWPAT
IF INSTR(ANS$, "/" + GUESS$) > 0 AND LEN(GUESS$) > 1 THEN GOTO NEWPAT
FAUL = FAUL + 1
IF FAUL < 3 THEN
LOCATE 24, 1
COLOR 31
PRINT "Try again!";
OS2SOUND 40, 40
COLOR 9
GOTO AGAIN
ELSE
LOCATE 24, 1
COLOR 6
PRINT "The word was:";
FOR KK = 80 TO 40 STEP -20
OS2SOUND KK, 40
NEXT KK
LOCATE 11, 27
PRINT "is";
LOCATE 12, 25
COLOR 7
PRINT ANS$; SPACE$(30);
COLOR 9
CALL GRABKEY(Q$)
END IF
ELSE
NEWPAT: LOCATE 12, 25
COLOR 7, 0
PRINT ANS$; SPACE$(30);
LOCATE 24, 1
COLOR 31
PRINT "Correct! ";
FOR KK = 1 TO 2
OS2SOUND 2500, 40
OS2SOUND 40, 40
NEXT
COLOR 9
SCORE = SCORE + 1
IF GEN < 5 THEN sleep 1
FOUND%(Q) = FOUND%(Q) + 1
END IF
ENG$(Q) = TMP$
LOCATE 20, 1
COLOR 3
IF GEN < 5 THEN GEN = GEN + 1: GOTO WORDS
PRINT "More words? "
GEN = 0
COLOR 9
AGAINST:
CALL GRABKEY(Q$)
IF Q$ = "Y" OR Q$ = "y" THEN GOTO WORDS
IF Q$ <> "N" AND Q$ <> "n" THEN GOTO AGAINST
FOR I = 0 TO 5
PRINT
NEXT
PRINT
COLOR 2
PRINT "Your score after "; QUEST; " questions is:"
PRINT
COLOR 12
SLEEP 2
GRADE = SCORE / QUEST * 100
IF GRADE > 89 THEN L$ = "A" ELSE IF GRADE > 79 THEN L$ = "B" ELSE IF GRADE > 69 THEN L$ = "C" ELSE IF GRADE > 59 THEN L$ = "D" ELSE L$ = "F"
L$ = "(" + L$ + ")"
PRINT USING "###.##\ \ \ \"; GRADE; "% correct"; L$
CALL GRABKEY(Q$)
CLOSE : GOTO 100
ADD:
CLS
PRINT
COLOR 3
PRINT "Locating free space..";
GET #1, 1
I = 1
WHILE NOT EOF(1)
GET #1, I
I = I + 1
WEND
I = I - 1
LOCATE , 1
PRINT SPACE$(70);
PRINT
PRINT "Enter lesson number to be entered: ";
INPUT LN
IF LN < 1 THEN RETURN
LSET LES.NO$ = MID$(STR$(LN), 2)
DONE = 0
WHILE NOT DONE
CLS
PRINT "Lesson number:"; LES.NO$
PRINT
PRINT "Enter word in Turkish, or blank return to save and exit."
INPUT W$
w$=ucase$(w$)
IF W$ = "" THEN DONE = -1
IF NOT DONE THEN
LSET WORD$ = W$
PRINT "Enter the corresponding English word for "; W$
INPUT W$
w$=ucase$(w$)
LSET CORR$ = W$
PUT #1, I
I = I + 1
END IF
WEND
RETURN
EDIT:
CLS
PRINT
COLOR 3
PRINT "Enter lesson number to be edited: ";
INPUT LN
IF LN < 1 THEN RETURN
LSET LES.NO$ = MID$(STR$(LN), 2)
GET #1,1
I=1
WHILE NOT EOF(1)
GET#1,I
IF VAL(LES.NO$)<> LN THEN GOTO EdNextword
PRINT WORD$ , CORR$
PRINT "<E>dit, <D>elete, <ENTER> to keep " ;
zz: AA$=ucase$(INPUT$(1))
IF AA$<>"E" and AA$<>"D" and AA$<>CHR$(13) THEN goto zz
PRINT AA$
IF AA$="D" THEN
LSET LES.NO$=""
LSET WORD$=""
LSET CORR$=""
PUT #1,I
GOTO EdNextWord
END IF
IF AA$="E" THEN
PRINT "Type in new word, or ENTER to keep "; WORD$
INPUT AH$
IF AH$<>"" THEN LSET WORD$=LTRIM$(RTRIM$(UCASE$(AH$)))
PRINT "Type in its equivalent, or ENTER to keep "; CORR$
INPUT AH$
IF AH$<>"" THEN LSET CORR$=LTRIM$(RTRIM$(UCASE$(AH$)))
PUT #1,I
GOTO EdNextWord
END IF
EdNextWord:
I=I+1
WEND
RETURN
SEARCH:
CLS
LOCATE 5, 1
TITLE = 0
PRINT "Enter word to be searched, or blank RETURN to get back."
LOCATE 12, 25
COLOR 7
INPUT W$
w$=ucase$(w$)
COLOR 3
W = LEN(W$)
IF W$ > "" THEN
GET #1, 1
WHILE NOT EOF(1)
IF INSTR(WORD$, W$) > 0 THEN GOSUB ECHO
IF INSTR(CORR$, W$) > 0 THEN GOSUB ECHO
IF INSTR(LES.NO$, W$) > 0 THEN GOSUB ECHO
GET #1
WEND
GET #1, 1
PRINT "Search complete. Hit any key"
CALL GRABKEY(Q$)
END IF
RETURN
RANDIT:
TT = INT(RND*(MAXLESS-MINLESS))+MINLESS+1
T$ = MID$(STR$(TT),2)
RETURN
ECHO:
IF TITLE = 0 THEN PRINT "Lesson #", "Turkish ", "English ": TITLE = -1
PRINT LES.NO$, WORD$, CORR$
RETURN
EXPLAIN:
CLS
RESTORE INFO
READ Q$
IZ = 1
WHILE Q$ <> "*"
IZ = IZ + 1
LOCATE LROW + IZ, LCOL + (70 - LEN(Q$)) / 2
PRINT Q$;
READ Q$
WEND
CALL GRABKEY(Q$)
RETURN
INFO:
DATA "User-Supported Software"," "
DATA "Instructions:"
DATA "This program has a rather large dictionary that contains both"
DATA "Turkish and English equivalents of every word. You may choose"
DATA "to be drilled on one or more chapters. If you wish to be quizzed"
DATA "on just one chapter, enter the number of the chapter, then hit"
DATA "SPACE BAR to begin. If you wish to combine several chapters into"
DATA "the quiz, then separate the chapter numbers by commas or dashes."
DATA "The program will keep asking the questions that you missed"
DATA "previously, mixing them with the unasked questions."
DATA "(A)dd option allows you to enter new words, even chapters."
DATA "(S)earch provides a quick look-up for unknown words."
DATA " ","If you like this program please send $20 to the address"
DATA "shown on the title screen. Thank you for supporting shareware!"
DATA "*"
SUB GRABKEY (V$) STATIC
V$ = ""
LOCATE , , 1,1,30
WHILE V$ = ""
V$ = INKEY$
WEND
V$ = UCASE$(V$)
END SUB
sub OS2SOUND(FREQ,DUR) STATIC
x = DOSBEEP(FREQ,DUR)
END SUB